home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / a-calend.adb < prev    next >
Text File  |  1994-05-19  |  15KB  |  422 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                         A D A . C A L E N D A R                          --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.16 $                             --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with System; use System;
  26. with System.Task_Clock;
  27. with System.Task_Clock.Machine_Specifics;
  28.  
  29. pragma Checks_On;
  30. --  We require checks on for this body, because we rely on the constraint
  31. --  error to keep Calendar.Time values within representable range.
  32.  
  33. package body Ada.Calendar is
  34.  
  35.    --  Type definitions for Unix functions localtime and mktime
  36.  
  37.    type Char_Pointer is access Character;
  38.  
  39.    type tm is record
  40.       tm_sec    : Integer range 0 .. 60;  -- seconds after the minute
  41.       tm_min    : Integer range 0 .. 59;  -- minutes after the hour
  42.       tm_hour   : Integer range 0 .. 23;  -- hours since midnight
  43.       tm_mday   : Integer range 1 .. 31;  -- day of the month
  44.       tm_mon    : Integer range 0 .. 11;  -- months since January
  45.       tm_year   : Integer;                -- years since 1900
  46.       tm_wday   : Integer range 0 .. 6;   -- days since Sunday
  47.       tm_yday   : Integer range 0 .. 365; -- days since January 1
  48.       tm_isdst  : Integer range 0 .. 1;   -- Daylight Savings Time flag
  49.       tm_gmtoff : Long_Integer;           -- offset from CUT in seconds
  50.       tm_zone   : Char_Pointer;           -- timezone abbreviation
  51.    end record;
  52.  
  53.    type tm_Pointer is access tm;
  54.  
  55.    subtype time_t is Long_Integer;
  56.  
  57.    type time_t_Pointer is access time_t;
  58.  
  59.    function localtime (C : time_t_Pointer) return tm_Pointer;
  60.    pragma Import (C, localtime);
  61.  
  62.    function mktime (TM : tm_Pointer) return time_t;
  63.    pragma Import (C, mktime);
  64.    --  mktime returns -1 in case the calendar time given by components of
  65.    --  TM.all cannot be represented.
  66.  
  67.    --  The following constants are used in adjusting Ada dates so that they
  68.    --  fit into the range that can be handled by Unix (1970 - 2062). The trick
  69.    --  is that the number of days in any four year period in the Ada range of
  70.    --  years (1901 - 2099) has a constant number of days. This is because we
  71.    --  have the special case of 2000 which, contrary to the normal exception
  72.    --  for centuries, is a leap year after all.
  73.  
  74.    Unix_Year_Min       : constant := 1970;
  75.    Unix_Year_Max       : constant := 2062;
  76.  
  77.    Ada_Year_Min        : constant := 1901;
  78.    Ada_Year_Max        : constant := 2099;
  79.  
  80.    Days_In_Month       : constant array (Month_Number) of Day_Number :=
  81.     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  82.  
  83.    Days_In_4_Years     : constant := 365 * 3 + 366;
  84.    Seconds_In_4_Years  : constant := 86_400 * Days_In_4_Years;
  85.    Seconds_In_4_YearsD : constant Duration := Duration (Seconds_In_4_Years);
  86.  
  87.    ---------
  88.    -- "+" --
  89.    ---------
  90.  
  91.    function "+" (Left : Time; Right : Duration) return Time is
  92.    begin
  93.       return (Left + Time (Right));
  94.    exception
  95.       when Constraint_Error => raise Time_Error;
  96.    end "+";
  97.  
  98.    function "+" (Left : Duration; Right : Time) return Time is
  99.    begin
  100.       return (Left + Time (Right));
  101.    exception
  102.       when Constraint_Error => raise Time_Error;
  103.    end "+";
  104.  
  105.    ---------
  106.    -- "-" --
  107.    ---------
  108.  
  109.    function "-" (Left : Time; Right : Duration)  return Time is
  110.    begin
  111.       return Left - Time (Right);
  112.    exception
  113.       when Constraint_Error => raise Time_Error;
  114.    end "-";
  115.  
  116.    function "-" (Left : Time; Right : Time) return Duration is
  117.    begin
  118.       return Duration (Left) - Duration (Right);
  119.    exception
  120.       when Constraint_Error => raise Time_Error;
  121.    end "-";
  122.  
  123.    ---------
  124.    -- "<" --
  125.    ---------
  126.  
  127.    function "<" (Left, Right : Time) return Boolean is
  128.    begin
  129.       return Duration (Left) < Duration (Right);
  130.    end "<";
  131.  
  132.    ----------
  133.    -- "<=" --
  134.    ----------
  135.  
  136.    function "<=" (Left, Right : Time) return Boolean is
  137.    begin
  138.       return Duration (Left) <= Duration (Right);
  139.    end "<=";
  140.  
  141.    ---------
  142.    -- ">" --
  143.    ---------
  144.  
  145.    function ">" (Left, Right : Time) return Boolean is
  146.    begin
  147.       return Duration (Left) > Duration (Right);
  148.    end ">";
  149.  
  150.    ----------
  151.    -- ">=" --
  152.    ----------
  153.  
  154.    function ">=" (Left, Right : Time) return Boolean is
  155.    begin
  156.       return Duration (Left) >= Duration (Right);
  157.    end ">=";
  158.  
  159.    -----------
  160.    -- Clock --
  161.    -----------
  162.  
  163.    --  The Ada.Calendar.Clock function gets the time from the GNULLI
  164.    --  interface routines. This ensures that Calendar is properly
  165.    --  coordinated with the tasking runtime. Any system dependence
  166.    --  involved in reading the clock is then hidden in the GNULLI
  167.    --  implementation layer (in the body of System.Task_Clock).
  168.  
  169.    function Clock return Time is
  170.    begin
  171.       return Time (Task_Clock.Stimespec_To_Duration (
  172.             Task_Clock.Machine_Specifics.Clock));
  173.    end Clock;
  174.  
  175.    ---------
  176.    -- Day --
  177.    ---------
  178.  
  179.    function Day (Date : Time) return Day_Number is
  180.       DY : Year_Number;
  181.       DM : Month_Number;
  182.       DD : Day_Number;
  183.       DS : Day_Duration;
  184.  
  185.    begin
  186.       Split (Date, DY, DM, DD, DS);
  187.       return DD;
  188.    end Day;
  189.  
  190.    -----------
  191.    -- Month --
  192.    -----------
  193.  
  194.    function Month (Date : Time) return Month_Number is
  195.       DY : Year_Number;
  196.       DM : Month_Number;
  197.       DD : Day_Number;
  198.       DS : Day_Duration;
  199.  
  200.    begin
  201.       Split (Date, DY, DM, DD, DS);
  202.       return DM;
  203.    end Month;
  204.  
  205.    -------------
  206.    -- Seconds --
  207.    -------------
  208.  
  209.    function Seconds (Date : Time) return Day_Duration is
  210.       DY : Year_Number;
  211.       DM : Month_Number;
  212.       DD : Day_Number;
  213.       DS : Day_Duration;
  214.  
  215.    begin
  216.       Split (Date, DY, DM, DD, DS);
  217.       return DS;
  218.    end Seconds;
  219.  
  220.    -----------
  221.    -- Split --
  222.    -----------
  223.  
  224.    procedure Split
  225.      (Date    : Time;
  226.       Year    : out Year_Number;
  227.       Month   : out Month_Number;
  228.       Day     : out Day_Number;
  229.       Seconds : out Day_Duration)
  230.    is
  231.       --  The following declare bounds for duration that are comfortably
  232.       --  wider than the maximum allowed output result for the Ada range
  233.       --  of representable split values. These are used for a quick check
  234.       --  that the value is not wildly out of range.
  235.  
  236.       Low  : constant := (Ada_Year_Min - Unix_Year_Min - 2) * 365 * 86_400;
  237.       High : constant := (Ada_Year_Max - Unix_Year_Max + 2) * 365 * 86_400;
  238.  
  239.       LowD  : constant Duration := Duration (Low);
  240.       HighD : constant Duration := Duration (High);
  241.  
  242.       --  The following declare the maximum duration value that can be
  243.       --  successfully converted to a 32-bit integer suitable for passing
  244.       --  to the localtime function. It might be more correct to use the
  245.       --  value Integer'Last here, but i